home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Utilities / ViewIt Shareware / ViewIt™ 2.04 Shareware / Projects / Pascal Demos / fDemoLP.pas < prev    next >
Pascal/Delphi Source File  |  1992-08-12  |  3KB  |  135 lines
  1. {FaceIt 2.04 Demonstration Program}
  2. {©FaceWare 1989-92.  All Rights Reserved.}
  3. {C1 - run program to see on-line comments}
  4. program fDemoLP;
  5. {$I-}
  6.  
  7. {C2}
  8.     uses
  9.         FaceStorLP, FaceProcLP;
  10.     var
  11.         i, mode: integer;
  12.         oldCount, newCount: longint;
  13.         keys: KeyMap;
  14.         fileName: Str255;
  15.  
  16. begin
  17.     with fRec do
  18.         begin
  19. {C3}
  20.             uName := 'fDemo.Rsrc';
  21. {C4,5}
  22.             FaceIt(nil, DoInit, 515, 0, 0, 0);
  23. {C6}
  24.             FaceIt(nil, NewWnd, 1030, 1, 0, 0);
  25. {C7}
  26.             repeat
  27.                 FaceIt(nil, DoLoop, 0, 0, 0, 0);
  28. {C8}
  29.                 case uMenuID of
  30. {C9}
  31.                     101: 
  32.                         if (uMenuItem = 1) then
  33.                             begin
  34.                                 uString := concat('Demonstration of the use of FaceIt', chr(13), 'to support program-wide features.');
  35.                                 FaceIt(nil, ShoStr, 3, 12, 1 + (409 * 65536), 0);
  36.                             end;
  37. {C10}
  38.                     105, 106, 107:
  39. {C11}
  40.                         case uMenuItem of
  41.                             1: 
  42.                                 SysBeep(5);
  43.                             2: 
  44.                                 begin
  45.                                     SysBeep(5);
  46.                                     SysBeep(5);
  47.                                 end;
  48.                             3: 
  49.                                 begin
  50.                                     SysBeep(5);
  51.                                     SysBeep(5);
  52.                                     SysBeep(5);
  53.                                 end;
  54. {C12}
  55.                             8: 
  56.                                 begin
  57. {C13}
  58.                                     FaceIt(nil, ShoAlt, 1010, 0, 1, 1);
  59.                                     mode := uResult;
  60.                                     oldCount := 0;
  61.                                     if (mode > 1) then
  62.                                         while true do
  63.                                             begin
  64. {C14}
  65.                                                 newCount := TickCount;
  66.                                                 if (newCount - oldCount > 180) then
  67.                                                     begin
  68.                                                         SysBeep(5);
  69.                                                         oldCount := newCount;
  70.                                                     end;
  71. {C15}
  72.                                                 if (mode = 2) then
  73.                                                     if GetNextEvent(-1, fEvent) then
  74.                                                         if (fEvent.what = 6) or (fEvent.what = 15) then
  75.                                                             FaceIt(nil, DoEvnt, 0, 0, 0, 0)
  76.                                                         else if (fEvent.what = 5) then
  77.                                                             leave;
  78. {C16}
  79.                                                 if (mode = 3) then
  80.                                                     begin
  81.                                                         GetKeys(keys);
  82.                                                         if BitTst(@keys, 61) and BitTst(@keys, 48) then
  83.                                                             begin
  84.                                                                 FlushEvents(62, 0);
  85.                                                                 leave;
  86.                                                             end;
  87.                                                     end;
  88.                                             end;
  89.                                 end;
  90.                             otherwise
  91.                         end;
  92. {C17}
  93.                     1030: 
  94.                         begin
  95.                             if (wcHit > 3) then
  96.                                 begin
  97.                                     FaceIt(nil, GetCtl, 1030, 0, 1, 4);
  98.                                     FaceIt(nil, PopMen, 107, cRect.top - 5, cRect.left - 11, 0);
  99.                                     wcHit := uMenuItem;
  100.                                 end;
  101.                             if (wcHit > 0) then
  102.                                 for i := 1 to wcHit do
  103.                                     SysBeep(5);
  104.                         end;
  105. {C18}
  106.                     1100: 
  107.                         if (uMenuItem = 2) then
  108.                             begin
  109.                                 if (fActiveWnd = nil) then
  110.                                     uString := 'No Window'
  111.                                 else if (fActiveID <> 1200) then
  112.                                     uString := 'Non-ViewIt Window'
  113.                                 else if (fActiveResID = 1010) then
  114.                                     uString := 'Editor Window'
  115.                                 else if (fActiveResID = 1020) then
  116.                                     uString := 'Clipboard Window'
  117.                                 else if (fActiveResID = 1030) then
  118.                                     uString := 'Beeps Window';
  119.                                 FaceIt(nil, SetItm2, 105, 10, 3, 0);
  120.                             end
  121. {C19}
  122.                         else if (uMenuItem = 512) then
  123.                             if (uString = 'TEXT') and (uResult = 1) then
  124.                                 begin
  125.                                     fileName := uName;
  126.                                     FaceIt(nil, GetCtl, 1010, 0, 1, 1);
  127.                                     uName := fileName;
  128.                                     FaceIt(cControl, 1551, 0, 1, 0, 0);    {OpnCTxt}
  129.                                 end;
  130.                     otherwise
  131.                 end;
  132.             until false;
  133.  
  134.         end;
  135. end.